home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / installed_progs / comm / ums / developer / demo / showgroups.mod < prev    next >
Encoding:
Text File  |  1993-09-22  |  4.7 KB  |  142 lines
  1. (* ------------------------------------------------------------------------
  2.   :Program.       ShowGroups
  3.   :Contents.      shows all groups in UMS' messagebase
  4.   :Author.        Kai Bolay [kai]
  5.   :Address.       Snail Mail:              EMail:
  6.   :Address.       Hoffmannstraße 168       UUCP: kai@amokle.stgt.sub.org
  7.   :Address.       D-71229 Leonberg         FIDO: 2:2407/106.3
  8.   :History.       v1.0 [kai] 25-Mar-93 (added Martin's suggestion)
  9.   :History.       v1.1 [kai] 15-Apr-93 (added SERVER keyword, better Login() failure, changed flag)
  10.   :History.       v1.2 [kai] 22-Sep-93 (updated for V40 Intefaces)
  11.   :Copyright.     Public Domain
  12.   :Language.      Oberon
  13.   :Translator.    AMIGA OBERON v3.01d
  14.   :Imports.       ums
  15. ------------------------------------------------------------------------ *)
  16. MODULE ShowGroups;
  17.  
  18. IMPORT
  19.   ums,
  20.   I: Intuition, d: Dos, e: Exec, u: Utility,
  21.   NoGuru, Break,
  22.   y: SYSTEM;
  23. CONST
  24.   Template = "USER/A,PASSWORD/A,SERVER/K,NEW/S\o$VER: ShowGroups 1.2 (22.9.93)\n\r";
  25. VAR
  26.   RD: d.RDArgsPtr;
  27.   Args: STRUCT (dummy: d.ArgsStruct)
  28.     name: e.STRPTR;
  29.     password: e.STRPTR;
  30.     server: e.STRPTR;
  31.     new: I.LONGBOOL;
  32.   END;
  33.   acc: LONGINT;
  34.   res, last: LONGINT;
  35.   Group: e.STRPTR;
  36.  
  37. (* $Debug- *)
  38. PROCEDURE CheckErr;
  39. VAR
  40.   err: INTEGER;
  41.   txt: ums.STRPTR;
  42. BEGIN
  43.   err := ums.ErrNum (acc);
  44.   IF err # ums.ok THEN
  45.     txt := ums.ErrTxt (acc);
  46.     d.PrintF ("UMS-error: %ld, \"%s\"\n", err, txt);
  47.     HALT (20);
  48.   END;
  49. END CheckErr;
  50. (* $Debug= *)
  51.  
  52. BEGIN
  53.   RD := d.ReadArgs (Template, Args, NIL);
  54.   IF RD = NIL THEN
  55.     d.PrintF ("Usage: %s\n", y.ADR (Template));
  56.     HALT (20);
  57.   END;
  58.   (* $OddChk- $NilChk- *)
  59.   acc := ums.UMSRLogin (Args.server^, Args.name^, Args.password^);
  60.   (* $OddChk= $NilChk= *)
  61.   IF acc <= 0 THEN
  62.     d.PrintF ("Unable to login\n");
  63.     HALT (20);
  64.   END;
  65.  
  66.   (* clear local flag 0 on all messages *)
  67.   res := ums.UMSSelectTags (acc, ums.tagSelWriteLocal, I.LTRUE,
  68.                                  ums.tagSelSet,        LONGSET {},
  69.                                  ums.tagSelUnset,      LONGSET {0},
  70.                                  u.done);
  71.   CheckErr;
  72.   d.PrintF ("there are %ld msgs in your messagebase\n", res);
  73.  
  74.   (* set local flag 0 on all readable messages *)
  75.   res := ums.UMSSelectTags (acc, ums.tagSelWriteLocal, I.LTRUE,
  76.                                  ums.tagSelSet,        LONGSET {0},
  77.                                  ums.tagSelUnset,      LONGSET {},
  78.                                  ums.tagSelMask,       LONGSET {ums.ViewAccess, ums.ReadAccess},
  79.                                  ums.tagSelMatch,      LONGSET {ums.ViewAccess, ums.ReadAccess},
  80.                                  u.done);
  81.   CheckErr;
  82.   d.PrintF ("you have access to %ld of thereof\n", res);
  83.  
  84.   IF Args.new = I.LTRUE THEN
  85.     (* clear local flag 0 on all read messages *)
  86.     res := ums.UMSSelectTags (acc, ums.tagSelWriteLocal, I.LTRUE,
  87.                                    ums.tagSelSet,        LONGSET {},
  88.                                    ums.tagSelUnset,      LONGSET {0},
  89.                                    ums.tagSelMask,       LONGSET {ums.Old},
  90.                                    ums.tagSelMatch,      LONGSET {ums.Old},
  91.                                    u.done);
  92.     CheckErr;
  93.     d.PrintF ("but %ld msgs are already read\n", res);
  94.   END;
  95.  
  96.   d.PrintF ("\n");
  97.   last := 0;
  98.   LOOP
  99.     (* find next message with flag 0 set *)
  100.     last := ums.UMSSearchTags (acc, ums.tagSearchLocal, I.LTRUE,
  101.                                     ums.tagSearchLast,  last,
  102.                                     ums.tagSearchMask,  LONGSET {0},
  103.                                     ums.tagSearchMatch, LONGSET {0},
  104.                                     u.done);
  105.     CheckErr;
  106.  
  107.     IF last = 0 THEN EXIT END; (* no more messages? *)
  108.  
  109.  
  110.     (* read the group of the message *)
  111.     IF ums.ReadUMSMsgTags (acc, ums.tagMsgNum,  last,
  112.                                 ums.tagRGroup,  y.ADR (Group),
  113.                                 u.done) THEN END;
  114.     CheckErr;
  115.  
  116.     (* clear local flag 0 on all messages belonging to this group *)
  117.     res := ums.UMSSelectTags (acc, ums.tagSelWriteLocal, I.LTRUE,
  118.                                    ums.tagSelQuick,      I.LTRUE,
  119.                                    ums.tagGroup,         Group,
  120.                                    ums.tagSelSet,        LONGSET {},
  121.                                    ums.tagSelUnset,      LONGSET {0},
  122.                                    u.done);
  123.     CheckErr;
  124.  
  125.     IF Group # NIL THEN
  126.       d.PrintF ("%5ld msgs in %s\n", res, Group);
  127.     ELSE
  128.       d.PrintF ("%5ld private msgs\n", res);
  129.     END;
  130.  
  131.     (* free the buffers belonging to the message *)
  132.     ums.FreeUMSMsg (acc, last);
  133.   END;
  134. CLOSE
  135.   IF acc # NIL THEN
  136.     ums.Logout (acc); acc := 0;
  137.   END;
  138.   IF RD # NIL THEN
  139.     d.FreeArgs (RD); RD := NIL;
  140.   END;
  141. END ShowGroups.
  142.